home *** CD-ROM | disk | FTP | other *** search
/ Workbench Add-On / Workbench Add-On - Volume 1.iso / BBS-Archive / Dev / Obrn-A_1.6_lib.lha / oberon-a / source3.lha / source / Kernel / LMath.asm < prev    next >
Assembly Source File  |  1995-06-29  |  7KB  |  267 lines
  1. **********************************************************************
  2. *
  3. *    $RCSfile: LMath.asm $
  4. * Description: Runtime support for the Oberon-A compiler
  5. *
  6. *  Created by: fjc (Frank Copeland)
  7. *   $Revision: 1.4 $
  8. *     $Author: fjc $
  9. *       $Date: 1995/06/29 19:03:32 $
  10. *
  11. * Copyright © 1994, Frank Copeland.
  12. * This file is part of the Oberon-A Library.
  13. * See Oberon-A.doc for conditions of use and distribution.
  14. *
  15. * Log entries are at the end of the file.
  16. *
  17. **********************************************************************
  18. *
  19. * Acknowledgements
  20. * ----------------
  21. *
  22. * The 32-bit multiply and divide procedures are from the runtime
  23. * library of Patrick Quaid's PCQ freeware Pascal compiler, which in
  24. * turn came from the runtime library of Sozobon C.
  25. *
  26. **********************************************************************
  27.  
  28. **********
  29. * lmath.s
  30. **********
  31. * Copyright (c) 1988 by Sozobon, Limited.  Author: Johann Ruegg
  32. *
  33. * Permission is granted to anyone to use this software for any purpose
  34. * on any computer system, and to redistribute it freely, with the
  35. * following restrictions:
  36. * 1) No charge may be made other than reasonable charges for
  37. *    reproduction.
  38. * 2) Modified versions must be clearly marked as such.
  39. * 3) The authors are not responsible for any harmful consequences
  40. *    of using this software, even if they result from defects in it.
  41. *
  42. *
  43. *       For PCQ Pascal:
  44. *            These are the 32-bit math functions from Sozobon-C,
  45. *       as noted above.  I changed the names of the routines to
  46. *       be more similar to the rest of my library, and handle the
  47. *       divide by zero condition differently.  Other than that I
  48. *       haven't changed the code a bit.
  49. *
  50. *       For Oberon-A:
  51. *            I have changed the names (again) and modified the
  52. *       routines to accept parameters passed in registers instead of
  53. *       on the stack, in keeping with the conventions I use in the
  54. *       rest of the compiler.
  55. *
  56. **********************************************************************
  57.  
  58. ;---------------------------------------------------------------------
  59. ;    Program unit hunk name
  60.  
  61.      TTL Kernel
  62.  
  63. ;---------------------------------------------------------------------
  64.  
  65.      ;----------------------------------------------------------------
  66.      ; PROCEDURE Kernel_Mul32 (
  67.      ;   l1 {D0} : LONGINT;
  68.      ;   l2 {D1} : LONGINT)
  69.      ; : LONGINT;
  70.      ;
  71.      ; Calculates l1 * l2, returning the result in D0.
  72.      ;----------------------------------------------------------------
  73.  
  74.      SECTION Kernel,CODE
  75.  
  76.      XDEF      Kernel_Mul32
  77.      XREF      Kernel_Halt
  78.  
  79. Kernel_Mul32:
  80.  
  81.         movem.l d2-d4,-(a7)
  82.         tst.l   d0
  83.         smi     d4
  84.         bpl     lm1
  85.         neg.l   d0
  86. lm1:
  87.         tst.l   d1
  88.         bpl     lm2
  89.         not.b   d4
  90.         neg.l   d1
  91. lm2:
  92.         move.w  d1,d2
  93.         mulu    d0,d2           /* d2 = Al * Bl */
  94.  
  95.         move.l  d1,d3
  96.         swap    d3
  97.         mulu    d0,d3           /* d3 = Al * Bh */
  98.  
  99.         swap    d0
  100.         mulu    d1,d0           /* d0 = Ah * Bl */
  101.  
  102.         add.l   d3,d0           /* d0 = (Ah*Bl + Al*Bh) */
  103.         swap    d0
  104.         clr.w   d0              /* d0 = (Ah*Bl + Al*Bh) << 16 */
  105.  
  106.         add.l   d2,d0           /* d0 = A*B */
  107.  
  108.         tst.b   d4
  109.         beq     lm3
  110.         neg.l   d0
  111. lm3:
  112.         movem.l (a7)+,d2-d4
  113.         rts
  114.  
  115. ;---------------------------------------------------------------------
  116.  
  117.      ;----------------------------------------------------------------
  118.      ; PROCEDURE Kernel_Div32
  119.      ;   l1 {D0} : LONGINT;
  120.      ;   l2 {D1} : LONGINT)
  121.      ; : LONGINT;
  122.      ;
  123.      ; Calculates l1 DIV l2, returning the result in D0 (quotient) and
  124.      ; D1 (remainder).
  125.      ;----------------------------------------------------------------
  126.  
  127.      SECTION Kernel,CODE
  128.  
  129.      XDEF      Kernel_Div32
  130. ;     XREF      Kernel.Halt
  131.  
  132. Kernel_Div32:
  133.  
  134.         movem.l d2-d5,-(a7)
  135.         tst.l   d0
  136.         smi     d4
  137.         bpl     ld1
  138.         neg.l   d0
  139. ld1:
  140.         tst.l   d1
  141.         smi     d5
  142.         bpl     ld2
  143.         neg.l   d1
  144.  
  145. ld2:
  146.         tst.l   d1
  147.         bne.s   nz1
  148.  
  149. *       divide by zero
  150.         move.l  #105,d0
  151.         lea     module,a0
  152.         move.l  (146*$10000)+19,d1
  153.         jsr     Kernel_Halt
  154. nz1:
  155.         cmp.l   d1,d0
  156.         bhi     norm
  157.         beq     is1
  158. *       A<B, so ret 0, rem A
  159.         move.l  d0,d1
  160.         clr.l   d0
  161.         bra.s ld5
  162. *       A==B, so ret 1, rem 0
  163. is1:
  164.         moveq.l #1,d0
  165.         clr.l   d1
  166.         bra.s ld5
  167. *       A>B and B is not 0
  168. norm:
  169.         cmp.l   #1,d1
  170.         bne.s   not1
  171. *       B==1, so ret A, rem 0
  172.         clr.l   d1
  173.         bra.s ld5
  174. *  check for A short (implies B short also)
  175. not1:
  176.         cmp.l   #$ffff,d0
  177.         bhi     slow
  178. *  A short and B short -- use 'divu'
  179.         divu    d1,d0           /* d0 = REM:ANS */
  180.         swap    d0              /* d0 = ANS:REM */
  181.         clr.l   d1
  182.         move.w  d0,d1           /* d1 = REM */
  183.         clr.w   d0
  184.         swap    d0
  185.         bra.s ld5
  186. * check for B short
  187. slow:
  188.         cmp.l   #$ffff,d1
  189.         bhi     slower
  190. * A long and B short -- use special stuff from gnu
  191.         move.l  d0,d2
  192.         clr.w   d2
  193.         swap    d2
  194.         divu    d1,d2           /* d2 = REM:ANS of Ahi/B */
  195.         clr.l   d3
  196.         move.w  d2,d3           /* d3 = Ahi/B */
  197.         swap    d3
  198.  
  199.         move.w  d0,d2           /* d2 = REM << 16 + Alo */
  200.         divu    d1,d2           /* d2 = REM:ANS of stuff/B */
  201.  
  202.         move.l  d2,d1
  203.         clr.w   d1
  204.         swap    d1              /* d1 = REM */
  205.  
  206.         clr.l   d0
  207.         move.w  d2,d0
  208.         add.l   d3,d0           /* d0 = ANS */
  209.         bra.s ld5
  210. *       A>B, B > 1
  211. slower:
  212.         move.l  #1,d2
  213.         clr.l   d3
  214. moreadj:
  215.         cmp.l   d0,d1
  216.         bhi.s   adj
  217.         add.l   d2,d2
  218.         add.l   d1,d1
  219.         bpl     moreadj
  220. * we shifted B until its >A or sign bit set
  221. * we shifted #1 (d2) along with it
  222. adj:
  223.         cmp.l   d0,d1
  224.         bhi.s   ltuns
  225.         or.l    d2,d3
  226.         sub.l   d1,d0
  227. ltuns:
  228.         lsr.l   #1,d1
  229.         lsr.l   #1,d2
  230.         bne     adj
  231. * d3=answer, d0=rem
  232.         move.l  d0,d1
  233.         move.l  d3,d0
  234.  
  235. ld5:
  236.         cmp.b   d4,d5
  237.         beq     ld3
  238.         neg.l   d0
  239. ld3:
  240.         tst.b   d4
  241.         beq     ld4
  242.         neg.l   d1
  243. ld4:
  244.         movem.l (a7)+,d2-d5
  245.         rts
  246.  
  247. module:
  248.         DC.B    "Kernel_Div32",0
  249.  
  250. ;---------------------------------------------------------------------
  251.  
  252.      END  ; Kernel
  253.  
  254. **********************************************************************
  255. *
  256. * $Log: LMath.asm $
  257. ;; Revision 1.4  1995/06/29  19:03:32  fjc
  258. ;; - Release 1.6
  259. ;;
  260. ;; Revision 1.3  1995/01/26  00:37:31  fjc
  261. ;; - Release 1.5
  262. ;;
  263. ;; Revision 1.3  1995/01/26  00:37:31  fjc
  264. ;; - Release 1.5
  265. ;;
  266. **********************************************************************
  267.